home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #2 / Monster Media No. 2 (Monster Media)(1994).ISO / prog_bas / ivbsrc.zip / COPYFILE.BAS < prev    next >
BASIC Source File  |  1992-08-12  |  3KB  |  109 lines
  1. Declare Function OpenFile Lib "Kernel" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Integer) As Integer
  2.  
  3. '  OpenFile() Flags
  4.  
  5. Const OF_READ = &H0
  6. Const OF_WRITE = &H1
  7. Const OF_CREATE = &H1000
  8.  
  9. Declare Function llseek Lib "Kernel" Alias "_llseek" (ByVal hFile As Integer, ByVal lOffset As Long, ByVal iOrigin As Integer) As Long
  10. Declare Function lclose Lib "Kernel" Alias "_lclose" (ByVal hFile As Integer) As Integer
  11.  
  12. Declare Function GlobalAlloc Lib "Kernel" (ByVal wFlags As Integer, ByVal dwBytes As Long) As Integer
  13. Declare Function GlobalFree Lib "Kernel" (ByVal hMem As Integer) As Integer
  14. Declare Function GlobalLock Lib "Kernel" (ByVal hMem As Integer) As Long
  15. Declare Function GlobalUnlock Lib "Kernel" (ByVal hMem As Integer) As Integer
  16.  
  17. Const GMEM_MOVEABLE = &H2
  18. Const GMEM_ZEROINIT = &H40
  19. Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
  20.  
  21. Declare Function hread Lib "kernel" Alias "_hread" (ByVal hFile%, ByVal memAddr&, ByVal dwBytes&) As Long
  22. Declare Function hwrite Lib "kernel" Alias "_hwrite" (ByVal hFile%, ByVal memAddr&, ByVal dwBytes&) As Long
  23.  
  24. Dim g_Of As OFSTRUCT
  25.  
  26. Const HFILE_ERROR = -1
  27.  
  28. Function CopyFile (InFile$, outFile$)
  29.  
  30. '********************************************************
  31. '  InFile$ is the source file full path and file name
  32. '  OutFile$ is the target file full path and file name
  33. '
  34. '  CopyFile returns "true" if copy completes successfully
  35. '  and "false" if there is an error.
  36. '********************************************************
  37.     
  38.     '--- open source file
  39.     inHndl% = OpenFile(InFile$, g_Of, OF_READ)
  40.     If inHndl% = HFILE_ERROR Then
  41.         fail% = 1
  42.         GoTo CopyError
  43.     End If
  44.     
  45.     '--- get size of source file
  46.     size& = llseek(inHndl%, 0, 2)
  47.     
  48.     '--- reset file pointer to start of file
  49.     msg& = llseek(inHndl%, 0, 0)
  50.     
  51.     '--- Open target file
  52.     OutHndl% = OpenFile(outFile$, g_Of, OF_CREATE Or OF_WRITE)
  53.     If OutHndl% = HFILE_ERROR Then
  54.         fail% = 2
  55.         GoTo CopyError
  56.     End If
  57.     
  58.     '--- allocate needed global memory
  59.     memHndl% = GlobalAlloc(GHND, size&)
  60.     If memHndl% = 0 Then
  61.         fail% = 3
  62.         GoTo CopyError
  63.     End If
  64.     
  65.     '--- lock global memory
  66.     memAddr& = GlobalLock(memHndl%)
  67.     
  68.     '--- read source file into global memory
  69.     inBytes& = hread(inHndl%, ByVal memAddr&, size&)
  70.     If inBytes& <> size& Then
  71.         fail% = 4
  72.         GoTo CopyError
  73.     End If
  74.     
  75.     '--- write global memory to target file
  76.     outBytes& = hwrite(OutHndl%, ByVal memAddr&, size&)
  77.     If outBytes& <> size& Then
  78.         fail% = 5
  79.         GoTo CopyError
  80.     End If
  81.     
  82.     '--- close source and target
  83.     ok% = lclose(inHndl%)
  84.     ok% = lclose(OutHndl%)
  85.     
  86.     '--- unlock and free global memory
  87.     ok% = GlobalUnlock(memHndl%)
  88.     ok% = GlobalFree(memHndl%)
  89.     ok% = DoEvents()
  90.     
  91.     '--- set COPYFILE exit code
  92.     CopyFile = HFILE_ERROR
  93.     Exit Function
  94.  
  95. CopyError:
  96.  
  97.     '--- clean up if there was an error
  98.     ok% = lclose(inHndl%)
  99.     ok% = lclose(OutHndl%)
  100.     ok% = GlobalUnlock(memHndl%)
  101.     ok% = GlobalFree(memHndl%)
  102.     ok% = DoEvents()
  103.     
  104.     '--- return failure code to calling proc
  105.     CopyFile = fail%
  106.  
  107. End Function
  108.  
  109.